﻿#!/usr/bin/perl

use strict;
use JSON;
use lib '../trunk';
use WWW::Metaweb::JSONLikePerl qw(:standard);
use Data::Dumper;

my $json = JSON->new;

my $st = qq({
	"guid":null,
	"id":{},
	"name" : {
		"id" : "#908a9809e09bff099090",
		"value" : true,
		"more_stuff" : "is here"
	},
	"type":["/location/postal_code", "/type/object"],
	"digit":54.3
});

my $sr = qq({
  "code":"/api/status/error",
  "messages":[{
    "code":"/api/status/error/mql/type",
    "info":{
      "expected_type":"/type/object",
      "property":"creato"
    },
    "message":"Type /type/object does not have property creato",
    "path":"",
    "query":{
      "/type/object/creator":null,
      "creato":null,
      "error_inside":".",
      "guid":null,
      "name":"Nico Minoru",
      "type":[]
    }
  }]
});

my $su = qq({"query":{"name":null,"league":"DSFLL","type":"/user/szaijan/fantasy_football/scoring","rule":[{"unit":null,"points":null,"activity":null}],"season":2007}});

my $name = jsonlp_quote('->{name}', $st, '{}');
print "[[[ $name ]]]\n";

my $error =jsonlp_fetch('->{messages}->[0]->{query}->{name}', $sr);
print "<<< $error >>>\n";
exit;

my $obj = $json->jsonToObj($st);
print Dumper $obj;
print $obj->{name} . "\n";
my $dst = $json->objToJson($obj);
print $dst . "\n";


sub jsonlp_traverse  {
	my $pp = shift; # Perl path
	my $js = shift; # JSON string
	my $action = shift; # Replacement for JSON segment
	my $super_inside = shift; # What we're inside
	my ($path_segment, $path_index, $json_segment, $remaining_pp, $parsed_js);

	# This means we've hit the bottom of our parsing.
	if (length $pp == 0)  {
		if (defined $action->{replace})  {
			return $action->{replace};
		}
		elsif (defined $action->{insert})  {
			my $insert = $action->{insert};
			$insert .= ',' if length $js > 0;
			$js =~ s/^(\s*)/$1$insert$1/;
			return $js;
		}
		else  {
			return $js;
		}
	}

	# Parse perl path
	if ($pp =~ /^->(\{.+?\})(.*)$/)  {
		$path_segment = $1;
		$remaining_pp = $2;
		$path_segment =~ s/[\{\}]//g;
	}
	elsif ($pp =~ /^->(\[\d+\])(.*)$/)  {
		$path_index = $1;
		$remaining_pp = $2;
		$path_index =~ s/[\[\]]//g;
	}
	elsif ($pp eq '->')  {
		$pp = '';
	}

	# Parse JSON
	my $isquoted = 0;
	my $cur = { curly => 0, square => 0 };
	my $begin = undef;
	my $inside = undef;
	my $am_a = undef;
	my $depth = 0;
	my $content = undef;
	my $current_name = undef;
	my $current_value = undef;
	my $value_index = undef;
	my $parse_value;
	for (my $i = 0; $i < length $js; $i++)  {
		my $c = substr $js, $i, 1;
		# Get the beginning count for brackets before this character.
		$begin = { posn => $i,
			   curly => $cur->{curly},
			   square => $cur->{square} } unless defined $begin;
		
		# Count the openning and closing of curly and square brackets,
		# they don't count if they're in quotes.
		if ($isquoted)  {
			if ($c eq '"')  {
				$isquoted = 0;
			}
		}
		else  {
			   if ($c eq '{')  { $cur->{curly}++; }
			elsif ($c eq '}')  { $cur->{curly}--; }
			elsif ($c eq '[')  { $cur->{square}++; }
			elsif ($c eq ']')  { $cur->{square}--; }
			elsif ($c eq '"')  {
				$isquoted = 1;
			}
		}

		# We're not inside any sort of delimiters
		if (not defined $inside)  {
			# Check for the beginning of an object
			if ($c eq '{')  {
				$inside = 'HASH';
			}
			elsif ($c eq '[')  {
				$inside = 'ARRAY';
			}
			elsif ($c eq '"')  {
				$inside = 'STRING';
			}
			elsif ($c =~ /[\d\-\+]/)  {
				$inside = 'NUMBER';
				$depth = 1;
			}
			elsif ($c =~ /\w/)  {
				$inside = 'BARE';
				$depth = 1;
			}

			# We've entered an object, decide whether it's a key or
			# value and set the begin hash to what sort of object
			# we're inside.
			if (defined $inside)  {
				$begin->{inside} = $inside;

				if ((not defined $am_a) && $inside eq 'STRING' && $super_inside ne 'ARRAY')  {
					$am_a = 'key';
				}
				elsif (not defined $am_a)  {
					$am_a = 'value';
				}
			}
			else  {
				# We're not inside an object, sratch begin, but
				# if we're on a ':' then a value is coming up.
				$begin = undef;
				if ((not defined $am_a) && $c eq ':')  {
					$am_a = 'value';
				}
			}

		}
		else  {
			# We can only end an object (leave inside) if the
			# bracket count is the same as before the object
			# started.
			my $matched = 0;
			$matched = 1 if ($begin->{curly} == $cur->{curly} && $begin->{square} == $cur->{square});

			if ($c eq '}' && $inside eq 'HASH' && $matched)  {
				$inside = undef;
			}
			elsif ($c eq ']' && $inside eq 'ARRAY' && $matched)  {
				$inside = undef;
			}
			elsif ($c eq '"' && $inside eq 'STRING' && $matched)  {
				$inside = undef;
			}
			elsif ($c !~ /[\d\.]/ && $inside eq 'NUMBER' && $matched)  {
				$content = substr($js, $i-$depth, $depth);
				$i--;
				$inside = undef;
			}
			elsif ($c !~ /\w/ && $inside eq 'BARE' && $matched)  {
				$content = substr($js, $i-$depth, $depth);
				$i--;
				$inside = undef;
			}
			else  {
				# We're going deeper into the object (in
				# characters).
				$depth++;
			}

			$content = substr($js, $i-$depth, $depth) unless defined $inside || defined $content;
		}

		# We've left an object (gone outside it), time to work.
		if ((not defined $inside) && (defined $content))  {
			if ($am_a eq 'key')  {
				# If it's a key, not much work to do.
				$current_name = $content;
				$current_value = undef;
				$value_index = 0;
			}
			elsif ($am_a eq 'value')  {
				# If this is an array, increase the value_index.
				if (defined $current_value)  {
					$value_index++;
				}
				else  {
					$value_index = 0;
				}
				$current_value = $content;

				my $returned = undef;
				my $traversed = 0;

				# If this value's name or index matches the perl
				# path (pp) we're following, recurse into it.
				if (($value_index == $path_index && defined $path_index) || ($current_name eq $path_segment && defined $path_segment))  {
					$returned = jsonlp_traverse($remaining_pp, $content, $action, $begin->{inside});
					$traversed = 1;
				}
				# Or if there's no name for this value and we
				# don't know what our outer structure is.
				elsif ((not defined $current_name) && (not defined $super_inside))  {
					$returned = jsonlp_traverse($pp, $content, $action, $begin->{inside});
					$traversed = 1
				}

				if ($traversed)  {
					# A value has been returned, that's
					# good, if we were replacing something
					# then replace it, otherwise return
					# just the value asked for.
					if (defined $returned)  {
						if (defined $action->{replace} || defined $action->{insert})  {
							my ($before, $after, $replace_delimeters);
							$replace_delimeters = 1 if $begin->{inside} ne 'NUMBER' && $begin->{inside} ne 'BARE' && length $remaining_pp == 0;

							$before = substr $js, 0, $begin->{posn} + (length $remaining_pp != 0 || defined $action->{insert});
							$after = substr $js, $begin->{posn} + length($content) + ($replace_delimeters*2) + (length $remaining_pp != 0) - (defined $action->{insert});
							$parsed_js = $before . $returned . $after;
						}
						else  {
							$parsed_js = $returned;
						}
					}

					# Once a traversal has been attempted,
					# we're on our way out.
					last;
				}
			} # Finished a value
			
			# Still moving sideways, reset all these values.
			$begin = undef;
			$am_a = undef;
			$content = undef;
			$depth = 0;
		}
	} # iterate through each chacter

	return $parsed_js;
} # &jsonlp_traverse

